Autores: Davi Augusto, Felipe Hedlund e João Arend.

1 Sobre a base de dados

A base de dados escolhida foi construída via scraping do site Wine Enthusiast e disponibilizada no site Kaggle.

Essa base de dados disponibiliza mais de 150.000 registros de vinhos ao redor do mundo e tem diversas informações relevantes a respeito, essas sendo: País de origem, descrição do vinho, designação,Pontuação,preço,província de origem, região de plantação, vaiedade da uva e a vinicula de origem.

1.1 Objetivo:

O objetivo dessa pesquisa é estudar as tendencias a respeito do mundo dos vinhos mais a respeito de preço que os vinhos são vendidos, como suas medias de preço e suas respectivas pontuações que são dadas por sommelieres dessa cultura.

2 Resumo das Variáveis:

  • País: o país de origem do vinho
  • Descrição: algumas frases de um sommelier descrevendo o sabor, cheiro, aparência, toque do vinho, etc.
  • Designação: vinhedo da vínicola onde a uva foi colhida
  • Pontos: o número de pontos que a WineEnthusiast avaliou o vinho em uma escala de 1 a 100 (embora digam que só publicam avaliações de vinhos com pontuação >=80)
  • Preço: o preço do vinho(em dólares $)
  • Província: a província ou estado de origem do vinho
  • Região 1 e Região 2: maoir detalhamento e especificidade sobre a área de plantação
  • Variedade: o tipo de uva usada para fazer o vinho
  • Vinícola: vinícola onde o vinho foi feito


3 Maiores e menores preços de vinho

Acreditamos que seria importante começar essa pesquisa com uma noção do quanto se paga nesses vinhos sejam eles mais caros ou mais baratos, e assim criamos essas tabelas para termos uma ideia mais organizada a respeito do assunto e, considerando o tamanho do banco de dados, utilizamos tabelas de frequencia a fim de resumir a informação presente e ter uma noção mais clara e simples sobre a pesquisa.

3.1 Top 13 vinhos mais caros

########### CRIANDO A TABELA COM OS TOP 13 MAIORES PREÇOS
# Primeiro, obtive os valores únicos da coluna 'Price'
precos_unicos_maiores <- unique(wine_data_wout_na$price)

# Em seguida, ordenei esses valores em ordem decrescente
precos_ordenados_maiores <- sort(precos_unicos_maiores, decreasing = TRUE)

# Selecionei os 13 maiores preços
top_13_precos_maiores <- precos_ordenados_maiores[1:10]

# Criei a sub-tabela com os vinhos que têm esses preços
subtabela_precos_maiores <- wine_data_wout_na[wine_data_wout_na$price %in% top_13_precos_maiores, ]


## Tabela dos 13 maiores preços
knitr::kable(
  head(subtabela_precos_maiores, 13),
  col.names = rotulos, 
  align = c("c", "c","l","l","c","c","l","l","l","l","l")
)
Id País Descrição Designação Pontos Preço Província Região 1 Região 2 Variedade Vinícola
34920 France A big, powerful wine t… NA 99 2300 Bordeaux Pauillac NA Bordeaux-style Red Blend Château Latour
13318 US The nose on this singl… Roger Rose Vineyard 91 2013 California Arroyo Seco Central Coast Chardonnay Blair
34922 France A massive wine for Mar… NA 98 1900 Bordeaux Margaux NA Bordeaux-style Red Blend Château Margaux
26296 France A wine that has create… Clos du Mesnil 100 1400 Champagne Champagne NA Chardonnay Krug
51886 France A wine that has create… Clos du Mesnil 100 1400 Champagne Champagne NA Chardonnay Krug
83536 France A wine that has create… Clos du Mesnil 100 1400 Champagne Champagne NA Chardonnay Krug
34939 France The purest Cabernet Sa… NA 96 1300 Bordeaux Pauillac NA Bordeaux-style Red Blend Château Mouton Rothschild
34942 France Solid, very structured… NA 96 1200 Bordeaux Pessac-Léognan NA Bordeaux-style Red Blend Château Haut-Brion
10651 Austria Wet earth, rain-wet st… Ried Loibenberg Smaragd 94 1100 Wachau NA NA Grüner Veltliner Emmerich Knoll
34927 France Such a generous and ri… NA 97 1100 Bordeaux Pessac-Léognan NA Bordeaux-style Red Blend Château La Mission Haut-Brion
35531 France This is the first vint… NA 94 1000 Bordeaux Pessac-Léognan NA Bordeaux-style White Blend Château La Mission Haut-Brion
10886 Portugal This was a great vinta… Colheita White 94 980 Port NA NA Port Kopke
90744 Italy Biondi-Santi performs … Riserva 94 900 Tuscany Brunello di Montalcino NA Sangiovese Grosso Biondi Santi 
########### CRIANDO A TABELA COM OS TOP 13 MENORES PREÇOS
# Primeiro, obtive os valores únicos da coluna 'Price'
precos_unicos_menores <- unique(wine_data_wout_na$price)

# Em seguida, ordenei esses valores em ordem crescente
precos_ordenados_menores <- sort(precos_unicos_menores)

# Selecionei os 13 maiores preços
top_13_precos_menores <- precos_ordenados_menores[1:10]

# Criei a sub-tabela com os vinhos que têm esses preços
subtabela_precos_menores <- wine_data_wout_na[wine_data_wout_na$price %in% top_13_precos_menores, ]

subtabela_precos_menores <- head(subtabela_precos_menores[order(subtabela_precos_menores$price), ], 13)

## Tabela dos 13 menores preços
knitr::kable(
  head(subtabela_precos_menores, 13),
  col.names = rotulos, 
  align = c("c", "c","l","l","c","c","l","l","l","l","l")
)
Id País Descrição Designação Pontos Preço Província Região 1 Região 2 Variedade Vinícola
1858 US Sweet and fruity, this… Unoaked 83 4 California California California Other Chardonnay Pam’s Cuties
25645 US There’s a lot going on… NA 86 4 California California California Other Merlot Bandit
34415 Spain This opens with standa… NA 84 4 Levante Yecla NA Cabernet Sauvignon Terrenal
34682 Spain Nice on the nose, this… Estate Bottled 84 4 Levante Yecla NA Tempranillo Terrenal
36716 Argentina Crimson in color but a… Red 84 4 Mendoza Province Mendoza NA Malbec-Syrah Broke Ass
48655 US There’s a lot going on… NA 86 4 California California California Other Merlot Bandit
73417 Romania Notes of sun-dried hay… UnWineD 86 4 Viile Timisului NA NA Pinot Grigio Cramele Recas
80185 US There’s a lot going on… NA 86 4 California California California Other Merlot Bandit
90546 Argentina Clean as anyone should… NA 85 4 Mendoza Province Mendoza NA Malbec Toca Diamonte
91766 Argentina Crimson in color but a… Red 84 4 Mendoza Province Mendoza NA Malbec-Syrah Broke Ass
99045 Portugal This is a ripe-fruited… Toutalga 86 4 Alentejano NA NA Portuguese Red Herdade dos Machados
102035 Spain This opens with standa… NA 84 4 Levante Yecla NA Cabernet Sauvignon Terrenal
102332 Spain Nice on the nose, this… Estate Bottled 84 4 Levante Yecla NA Tempranillo Terrenal

3.1.1 Tabelas de frequência dos 13 maiores preços

######## TABELAS DE FREQUENCIA
# Tabela de frequência dos top 13 maiores preços por país
freq(subtabela_precos_maiores$country)
## Frequencies  
## subtabela_precos_maiores$country  
## Label: País  
## Type: Character  
## 
##                  Freq   % Valid   % Valid Cum.   % Total   % Total Cum.
## -------------- ------ --------- -------------- --------- --------------
##        Austria      1      7.69           7.69      7.69           7.69
##         France      9     69.23          76.92     69.23          76.92
##          Italy      1      7.69          84.62      7.69          84.62
##       Portugal      1      7.69          92.31      7.69          92.31
##             US      1      7.69         100.00      7.69         100.00
##           <NA>      0                               0.00         100.00
##          Total     13    100.00         100.00    100.00         100.00
# Tabela de frequência dos top 13 maiores preços por variedade do vinho
freq(subtabela_precos_maiores$variety)
## Frequencies  
## subtabela_precos_maiores$variety  
## Label: Variedade  
## Type: Character  
## 
##                                    Freq   % Valid   % Valid Cum.   % Total   % Total Cum.
## -------------------------------- ------ --------- -------------- --------- --------------
##         Bordeaux-style Red Blend      5     38.46          38.46     38.46          38.46
##       Bordeaux-style White Blend      1      7.69          46.15      7.69          46.15
##                       Chardonnay      4     30.77          76.92     30.77          76.92
##                 Grüner Veltliner      1      7.69          84.62      7.69          84.62
##                             Port      1      7.69          92.31      7.69          92.31
##                Sangiovese Grosso      1      7.69         100.00      7.69         100.00
##                             <NA>      0                               0.00         100.00
##                            Total     13    100.00         100.00    100.00         100.00

3.1.1.1 Tabelas de frequência dos 13 menores preços

######## TABELAS DE FREQUENCIA
# Tabela de frequência dos top 13 menores preços por país
freq(subtabela_precos_menores$country)
## Frequencies  
## subtabela_precos_menores$country  
## Label: País  
## Type: Character  
## 
##                   Freq   % Valid   % Valid Cum.   % Total   % Total Cum.
## --------------- ------ --------- -------------- --------- --------------
##       Argentina      3     23.08          23.08     23.08          23.08
##        Portugal      1      7.69          30.77      7.69          30.77
##         Romania      1      7.69          38.46      7.69          38.46
##           Spain      4     30.77          69.23     30.77          69.23
##              US      4     30.77         100.00     30.77         100.00
##            <NA>      0                               0.00         100.00
##           Total     13    100.00         100.00    100.00         100.00
# Tabela de frequência dos top 13 menores preços por variedade do vinho
freq(subtabela_precos_menores$variety)
## Frequencies  
## subtabela_precos_menores$variety  
## Label: Variedade  
## Type: Character  
## 
##                            Freq   % Valid   % Valid Cum.   % Total   % Total Cum.
## ------------------------ ------ --------- -------------- --------- --------------
##       Cabernet Sauvignon      2     15.38          15.38     15.38          15.38
##               Chardonnay      1      7.69          23.08      7.69          23.08
##                   Malbec      1      7.69          30.77      7.69          30.77
##             Malbec-Syrah      2     15.38          46.15     15.38          46.15
##                   Merlot      3     23.08          69.23     23.08          69.23
##             Pinot Grigio      1      7.69          76.92      7.69          76.92
##           Portuguese Red      1      7.69          84.62      7.69          84.62
##              Tempranillo      2     15.38         100.00     15.38         100.00
##                     <NA>      0                               0.00         100.00
##                    Total     13    100.00         100.00    100.00         100.00

4 Gráficos com as informações das médias

Agora que temos uma noção a respeito dos valores, queriamos mostrar a média de preço dos vinhos em cada país e decidimos usar uma ferramenta mais gráfica tal qual o grafico de barras.

############ GRÁFICO MÉDIA PREÇOS POR PAÍS ################
# Cálculo de média de preço por país
media_preco_por_pais <- aggregate(wine_data_wout_na$price, by=list(wine_data_wout_na$country), FUN=mean, na.rm=TRUE)

# Renomeando as colunas para tornar o resultado mais claro
colnames(media_preco_por_pais) <- c("País", "Média de Preço")

# Ordenando o resultado em ordem decrescente de média de preço
media_preco_por_pais <- media_preco_por_pais[order(media_preco_por_pais$`Média de Preço`, decreasing=TRUE), ]

# Ordenando os níveis da variável 'País' com base nas médias de preço em ordem decrescente
media_preco_por_pais$País <- factor(media_preco_por_pais$País, levels=media_preco_por_pais$País[order(media_preco_por_pais$`Média de Preço`)])

# Aqui está meu gráfico de média de  preço por país!
grafico_preco_por_pais <- ggplot(media_preco_por_pais, aes(x=`Média de Preço`, y=País, fill=`Média de Preço`)) +
  geom_bar(stat="identity") +
  labs(title="Comparação de Médias de Preço por País", x="Média de Preço", y="País") +
  theme_minimal() +
  scale_fill_gradient(low="maroon", high="#722F37")

# Printa o gráfico
print(grafico_preco_por_pais)

Agora que sabemos as médias julgamos importante pesquisar o quanto os preços poderiam variar nesses paises e por essa razão criamos uma tabela de variancia.

############ CALCULO DE VAR E DESVIO PADRÃO DE FORMA TABULAR ################
# Calcula  a variância das pontuações por preço
variancia_price_pais <- wine_data_wout_na %>%
  group_by(country) %>%
  summarise(Variância = var(price, na.rm = TRUE))

# Ordene a tabela de variância em ordem decrescente
variancia_price_pais <- variancia_price_pais %>%
  arrange(desc(Variância))

# Printa a tabela de variância
print(variancia_price_pais)
## # A tibble: 46 × 2
##    country   Variância
##    <chr>         <dbl>
##  1 France        4858.
##  2 Hungary       4391.
##  3 Germany       3233.
##  4 Australia     1522.
##  5 Italy         1374.
##  6 Portugal      1242.
##  7 Spain         1147.
##  8 Romania        832.
##  9 Austria        815.
## 10 US             620.
## # ℹ 36 more rows
# Calculei o desvio padrão dos preços por país
desvio_padrao_precos <- wine_data_wout_na %>%
  group_by(country) %>%
  summarise(Desvio_Padrao_Precos = sd(price, na.rm = TRUE))
desvio_padrao_precos
## # A tibble: 46 × 2
##    country                Desvio_Padrao_Precos
##    <chr>                                 <dbl>
##  1 Albania                                0   
##  2 Argentina                             20.2 
##  3 Australia                             39.0 
##  4 Austria                               28.5 
##  5 Bosnia and Herzegovina                 0.5 
##  6 Brazil                                 8.84
##  7 Bulgaria                               4.96
##  8 Canada                                24.3 
##  9 Chile                                 19.6 
## 10 China                                 11.5 
## # ℹ 36 more rows

E aqui está um grafico que exemplifica melhor o que queremos transmitir

################# GRÁFICO VARIÂNCIA PREÇO PAÍS ###############################

## Ordenei a subtabela criada 'wine_countries' para obter os n_records em 
# ordem decrescente
wine_countries_preco <- wine_countries %>% arrange(desc(n_records))

## Aqui eu pego somente as 4 ocorrências desse ordenamento
subtabela_precos_var <- head(wine_countries_preco, 4)


## Utilizo as 4 mais frequentes 'n_records' da variavel subtabela preços para 
# filtrar a tabela tratada sem NA's completa dos vinhos.
plot_precos_var <- filter(wine_data_wout_na, 
                          country %in% subtabela_precos_var$country)

## GGPLOT(Box_Plot) para analisar variância
wine_preco_variancia <- ggplot(plot_precos_var, aes(country, price)) +
  labs(title="Variância de Preço por País", x="Preço($)", y="País") +
  geom_boxplot(fill = "#722F37", colour = "black")

print(wine_preco_variancia)

5 Média por país.

Aproveitando que estamos falando sobre países, montamos um grafico a respeito de media de pontuação em cada país para descobrir qual país teria, em media, os melhores vinhos.

# Calculei a média de pontuações por país
media_pontuacao_por_pais <- aggregate(wine_data_wout_na$points, by=list(wine_data_wout_na$country), FUN=mean, na.rm=TRUE)

# Renomeando as colunas para tornar o resultado mais claro
colnames(media_pontuacao_por_pais) <- c("País", "Média de Pontuação")

# Ordenando o resultado em ordem decrescente de média de pontuação
media_pontuacao_por_pais$País <- factor(media_pontuacao_por_pais$País, levels=media_pontuacao_por_pais$País[order(media_pontuacao_por_pais$`Média de Pontuação`)])

# Aqui está o gráfico de média de pontuação por país
grafico_pontuacao_por_pais <- ggplot(media_pontuacao_por_pais, aes(x=`Média de Pontuação`, y= País, fill=`Média de Pontuação`)) +
  geom_bar(stat="identity") +
  labs(title="Comparação de Médias de Pontuação por País", x="Média de Pontuação", y="País") +
  theme_minimal() +
  coord_cartesian(xlim = c(0, 90)) +
  scale_fill_gradient(low="maroon", high="#722F37")

# Printa o gráfico
print(grafico_pontuacao_por_pais)

5.1 tabela de variancia.

# Calcule a variância das pontuações por pontuação
variancia_pts_pais <- wine_data_wout_na %>%
  group_by(country) %>%
  summarise(Variância = var(points, na.rm = TRUE))

# Ordene a tabela de variância em ordem decrescente
variancia_pts_pais <- variancia_pts_pais %>%
  arrange(desc(Variância))

# Printa a tabela
print(variancia_pts_pais)
## # A tibble: 46 × 2
##    country     Variância
##    <chr>           <dbl>
##  1 India           13.4 
##  2 US              11.6 
##  3 Switzerland     11.6 
##  4 Hungary         11.5 
##  5 France           9.87
##  6 Spain            9.79
##  7 Argentina        9.57
##  8 Georgia          9.49
##  9 Australia        8.89
## 10 Portugal         8.58
## # ℹ 36 more rows
# Calcula o desvio padrão das pontuações por país
desvio_padrao_pontuacoes <- wine_data_wout_na %>%
  group_by(country) %>%
  summarise(Desvio_Padrao_Pontuacoes = sd(points, na.rm = TRUE))

desvio_padrao_pontuacoes
## # A tibble: 46 × 2
##    country                Desvio_Padrao_Pontuacoes
##    <chr>                                     <dbl>
##  1 Albania                                    0   
##  2 Argentina                                  3.09
##  3 Australia                                  2.98
##  4 Austria                                    2.49
##  5 Bosnia and Herzegovina                     2.36
##  6 Brazil                                     1.67
##  7 Bulgaria                                   2.56
##  8 Canada                                     2.47
##  9 Chile                                      2.71
## 10 China                                      0   
## # ℹ 36 more rows
################# GRÁFICO VARIÂNCIA PONTUAÇÃO PAÍS ############################
## Estou usando o mesmo código utilizado acima para apresentação de variância
# dos preços dos 4 países mais frequentes. Só estou alterando o eixo do gráfico
# para apresentar a variância da pontuação desta vez

## GGPLOT(Box_Plot) para analisar variância de pontuação por país
wine_pts_variancia <- ggplot(plot_precos_var, aes(country, points)) +
  labs(title="Variância de Pontuação por País", x="Preço($)", y="País") +
  geom_boxplot(fill = "#722F37", colour = "black")

print(wine_pts_variancia)

6 Correlação entre preço e pontuação.

Agora vamos mostrar a vocês se,de fato, os vinhos mais bem pontuados são os melhores.

# Including Plots
wine_plot_price_points <- ggplot(wine_data_wout_na) +
                          aes(points, price) +
                          geom_point(color = '#722F37') + 
                          theme_minimal() + 
                          labs(title="Relação entre Preço e Pontuação",
                               x = "Pontos",
                               y = "Preço ($)") + 
                          scale_x_continuous(breaks = seq(80, 100, 2)) + 
                          scale_y_continuous(breaks = seq(0, 3000, 250))
wine_plot_price_points

6.1 Relação entre produção de vinhos e pontuação.

wine_plot_hist_points <- ggplot(wine_data_wout_na, 
                                aes(x = points)) +
                        geom_histogram(binwidth = 1, fill = "#722F37", color = "#800020") +  
                        theme_minimal() + 
                        labs(x = "Pontos",
                             y = "Número de registros") + 
                        scale_x_continuous(breaks = seq(80, 100, 2)) + 
                        scale_y_continuous(breaks = seq(0, 20000, 3000)) 
wine_plot_hist_points

summary(wine_data_wout_na$price)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00   16.00   24.00   33.13   40.00 2300.00
## Verificar se tem como melhorar se não descartar
# wine_plot_hist_price  <- ggplot(wine_data_wout_na, 
#                                 aes(x = price)) +
#                         geom_histogram(binwidth = 1, fill = "#FFBF00", color = '#FFD700') +  
#                         theme_minimal() + 
#                         labs(x = "Preço",
#                              y = "Número de registros") + 
#                         scale_x_continuous(breaks = seq(0, 3000, 250)) + 
#                         scale_y_continuous(breaks = seq(0, 20000, 3000)) 
# wine_plot_hist_price

7 Comparação entre preço médio e produção de vinhos pelos paises

Ao longo do trabalho foi possivel notar que existem muitos registros de vinhos, pensamos que seria interessante realizar uma relação entre o número de registros por paises e o preço medio em que esses registros se encontram

wine_counts <- wine_data %>%
  group_by(country) %>%
  summarise(count = n(), avg_price = mean(price, na.rm = TRUE))

###definindo valores que serão utilizados em graficos posteriores.
limiteX<-50

limitesupX<-2000

### grafico com todos os valores demonstrados.
ggplot(wine_counts, aes(x = count, y = avg_price)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "Quantidade de Registros",
       y = "Preço Médio",
       title = "Relação entre Quantidade de registros e Preço Médio por País") +
  theme_minimal()

Como os pontos estavam muito afastados resolvemos ir aproximando a escala para ver melhor aqueles que estavam aglutinados na esquerda

###grafico onde a escala x se encontra em 2000

   ggplot(wine_counts, aes(x = count, y = avg_price)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "Quantidade de Registros",
       y = "Preço Médio",
       title = "Relação entre Quantidade de registros e Preço Médio por País") +
  theme_minimal()+
  xlim(0, limitesupX)

E com isso é possivel notar que a maioria dos paises dessa base de dados tem 50 ou menos registros em comparação a outros como EUA ou França.

#grafico onde a escala x se encontra em 50

 ggplot(wine_counts, aes(x = count, y = avg_price)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  labs(x = "Quantidade de Registros",
       y = "Preço Médio",
       title = "Relação entre Quantidade de registros e Preço Médio por País") +
  theme_minimal()+
  xlim(0, limiteX)

8 Nuvem de palavras

Achamos que seria interessante adicionar um wordcloud sobre as palavras que mais se repetiram na descrição, para que pudessemos ter uma ideia melhor sobre as palavras chaves que os sommelieres utilizaram para descrever os vinhos das províncias com maior média de pontos.

wine_best_provinces <- head(wine_provinces %>% arrange(desc(av_points))
                                           %>% filter(n_records > 10), 10)

wine_provinces_desc <- wine_data %>%
                       filter(wine_data$province %in% wine_best_provinces$province)



wine_desc_cloud <- Corpus(VectorSource(wine_provinces_desc$description))
wine_desc_cloud <- tm_map(wine_desc_cloud, PlainTextDocument)
wine_desc_cloud <- tm_map(wine_desc_cloud, content_transformer(tolower))
wine_desc_cloud <- tm_map(wine_desc_cloud, removePunctuation)
wine_desc_cloud <- tm_map(wine_desc_cloud, removeNumbers)
wine_desc_cloud <- tm_map(wine_desc_cloud, removeWords, stopwords('en'))
wine_desc_cloud <- tm_map(wine_desc_cloud, stemDocument)
wine_desc_cloud <- tm_map(wine_desc_cloud, stripWhitespace)

wordcloud(wine_desc_cloud, max.words = 50, scale=c(6,1.0), colors=brewer.pal(8, "Dark2"))

9 Conclusão:

Ao longo deste trabalho foi possivel entender melhor a cultura em torno dos vinhos e adquirir algumas informações interessante a respeito,e a frança ser o país mais diversificado a respeito de vinhos, o que não era inesperado,ou o fato de haver muitos vinhos nota 100 sem que eles custem milhares de dolares mostrando que pessoas de classes mais baixas podem sim experimentar e se deliciar com um vinho de boa qualidade. Em suma, nos mostra o quão diversificado é a vinicultura e o quanto podemos aprender com um simples banco de dados.